home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / sml_nj / 93src.lha / src / sparc / sparc.sml next >
Encoding:
Text File  |  1993-01-27  |  26.2 KB  |  795 lines

  1. (* sparc.sml
  2.  *
  3.  * Copyright 1989 by AT&T Bell Laboratories
  4.  *
  5.  * AUTHOR:  John Reppy
  6.  *        Cornell University
  7.  *        Ithaca, NY 14853
  8.  *        jhr@cs.cornell.edu
  9.  *)
  10.  
  11. functor SparcCM (
  12.     structure C : CODER
  13.     sharing type C.instruction = SparcInstr.instruction
  14.         and type C.sdi = SparcInstr.sdi) : CMACHINE =
  15.   struct
  16.  
  17.     structure C' : sig
  18.     eqtype label
  19.     val mark : unit -> unit
  20.     val comment : string -> unit
  21.     exception BadReal of string
  22.     end = C
  23.     open C'
  24.  
  25.     structure S' : sig
  26.     datatype register = REG of int
  27.     datatype fregister = FREG of int
  28.     datatype 'label labelexp
  29.       = LABELexp of {       (* An offset relative to a label.  The value of a *)
  30.           base : 'label,    (* label expression is ((dst - base) + offset). *)
  31.           dst : 'label,
  32.           offset : int
  33.         }
  34.     datatype 'label operand
  35.       = REGrand of register     (* A register value *)
  36.       | IMrand of int           (* A small integer constant (13 bits) *)
  37.       | LABrand of 'label labelexp     (* A small valued label expression (13 bits) *)
  38.       | HIrand of 'label labelexp      (* The high 22 bits of a label expression *)
  39.       | LOrand of 'label labelexp      (* The low 10 bits of a label expression *)
  40.     datatype cond_code
  41.       = CC_A | CC_E | CC_NE | CC_G | CC_GE | CC_L | CC_LE | CC_GEU | CC_LEU
  42.       end = SparcInstr
  43.     open S'
  44.  
  45.     val zeroR = REG 0                       (* %g0 *)
  46.     val zeroRand = REGrand zeroR
  47.  
  48.     local
  49.  
  50.       fun emit_ld args = C.emit (SparcInstr.I_ld args)
  51.       fun emit_ldb args = C.emit (SparcInstr.I_ldb args)
  52.       fun emit_ldf args = C.emit (SparcInstr.I_ldf args)
  53.       fun emit_st args = C.emit (SparcInstr.I_st args)
  54.       fun emit_stb args = C.emit (SparcInstr.I_stb args)
  55.       fun emit_stf args = C.emit (SparcInstr.I_stf args)
  56.       fun emit_sethi args = C.emit (SparcInstr.I_sethi args)
  57.       fun emit_bcc args = C.emit (SparcInstr.I_bcc args)
  58.       fun emit_fbcc args = C.emit (SparcInstr.I_fbcc args)
  59.       fun emit_jmpl args = C.emit (SparcInstr.I_jmpl args)
  60.       fun emit_jmp (r, offset) = C.emit (SparcInstr.I_jmpl(r, offset, zeroR))
  61.       fun emit_add args = C.emit (SparcInstr.I_add args)
  62.       fun emit_addcc args = C.emit (SparcInstr.I_addcc args)
  63.       fun emit_taddcctv args = C.emit (SparcInstr.I_taddcctv args)
  64.       fun emit_sub args = C.emit (SparcInstr.I_sub args)
  65.       fun emit_subcc args = C.emit (SparcInstr.I_subcc args)
  66.       fun emit_sra args = C.emit (SparcInstr.I_sra args)
  67.       fun emit_sll args = C.emit (SparcInstr.I_sll args)
  68.       fun emit_and args = C.emit (SparcInstr.I_and args)
  69.       fun emit_andcc args = C.emit (SparcInstr.I_andcc args)
  70.       fun emit_or args = C.emit (SparcInstr.I_or args)
  71.       fun emit_xor args = C.emit (SparcInstr.I_xor args)
  72.       fun emit_not args = C.emit (SparcInstr.I_not args)
  73.       fun emit_tvs () = C.emit SparcInstr.I_tvs
  74.       fun emit_fadd args = C.emit (SparcInstr.I_fadd args)
  75.       fun emit_fsub args = C.emit (SparcInstr.I_fsub args)
  76.       fun emit_fmul args = C.emit (SparcInstr.I_fmul args)
  77.       fun emit_fdiv args = C.emit (SparcInstr.I_fdiv args)
  78.       fun emit_fneg args = C.emit (SparcInstr.I_fneg args)
  79.       fun emit_fabs args = C.emit (SparcInstr.I_fabs args)
  80.       fun emit_fcmp args = C.emit (SparcInstr.I_fcmp args)
  81.       fun emit_fmov args = C.emit (SparcInstr.I_fmov args)
  82.       fun emit_fitod args = C.emit (SparcInstr.I_fitod args)
  83.  
  84.       local
  85.     fun mkLabExp (lab, n) = LABELexp{base= C.baseLab, dst= lab, offset= (n-4096)}
  86.       in
  87.  
  88.       fun setBaseAddr (lab, reg) = 
  89.            C.emitSDI (
  90.             SparcInstr.SetBaseAddr(mkLabExp(lab, 0), reg))
  91.  
  92.       fun loadAddr (lab, n, dst) = (
  93.         C.emitSDI (SparcInstr.LoadAddr(mkLabExp(lab, n), dst)))
  94.  
  95.       fun load (lab, n, dst, tmpR) = (
  96.         C.emitSDI (SparcInstr.Load(mkLabExp(lab, n), dst, tmpR)))
  97.  
  98.       fun loadF (lab, n, dst, tmpR) = (
  99.         C.emitSDI (SparcInstr.LoadF(mkLabExp(lab, n), dst, tmpR)))
  100.  
  101.       end (* local *)
  102.  
  103.     in
  104.  
  105.     datatype EA
  106.       = Immed of int
  107.       | ImmedLab of label
  108.       | Direct of register
  109.       | FDirect of fregister
  110.  
  111.     datatype condition = EQL | NEQ | GTR | GEQ | LSS | LEQ
  112.  
  113.     val immed = Immed
  114.  
  115.   (** Dedicated registers **)
  116.     val exnptr = Direct(REG 7)              (* %g7 *)
  117.     val storeptr = Direct(REG 5)            (* %g5 *)
  118.     val arithtemps = []
  119.     val varptr = Direct(REG 29)             (* %i5 *)
  120.     val varptr_indexable = true
  121.     val standardclosure = Direct(REG 26)    (* %i2 *)
  122.     val standardarg = Direct(REG 24)        (* %i0 *)
  123.     val standardcont = Direct(REG 25)       (* %i1 *)
  124.     val standardlink = Direct(REG 1)        (* %g1 *)
  125.     val miscregs = map (Direct o REG) [     (* %g2-%g3, %o0-%o1, %l0-%l7, %i4 *)
  126.       2, 3, 8, 9, 16, 17, 18, 19, 20, 21, 22, 23, 28
  127.       ]
  128.     (*
  129.      * cc treats none of the floating point registers as callee save.
  130.      *)
  131.     val savedfpregs = [] : EA list
  132.     val floatregs = let fun from(n,m) = if n > m then [] else n :: from(n+2,m)
  133.             in map (FDirect o FREG) (from(0,31))
  134.             end
  135.     val dataptrR = REG 6                    (* %g6 *)
  136.     val limitptrR = REG 4                   (* %g4 *)
  137.     val limitptrRand = REGrand limitptrR
  138.   (* the following two registers are used for calling ml_mul & ml_div *)
  139.     val spR = REG 14                        (* %sp (%o6) *)
  140.     val linkR = REG 15                      (* %o7, link register *)
  141.     val maskR = REG 13       (* %o5, also used as temporary *)
  142.     val checkR = REG 12      (* %o4, also used as temporary *)
  143.  
  144.   (** Temporary registers **
  145.    * We use registers %o2-%o5 as temporaries.  They are used in a round-robin
  146.    * order to facilitate instruction scheduling.
  147.    *)
  148.     local
  149.       val rear = ref 0 and queue = ref 0
  150.       fun ins i = let
  151.         val r = !rear
  152.         in
  153.           queue := Bits.orb(Bits.lshift(i, r), !queue);
  154.           rear := r + 5
  155.         end
  156.       fun remove () = let
  157.         val q = !queue
  158.         val x = Bits.andb (q, 31)
  159.         in
  160.           queue := Bits.rshift (q, 5);
  161.           rear := !rear - 5;
  162.           x
  163.         end
  164.       val _ = app ins [10, 11, 12, 13]      (* %o2-%o5 *)
  165.     in
  166.  
  167.   (* Registers %o2, %o3 & %o4 are also used to call ml_mul and ml_div. *)
  168.     val arg1EA = Direct(REG 10) and arg2EA = Direct(REG 11)
  169.     val opAddrR = REG 12
  170.  
  171.   (* Get a temporary register. *)
  172.     fun getTmpReg () = REG(remove())
  173.  
  174.    (* If r is a temporary register, then free it. *)
  175.     fun freeReg (REG r) = if ((9 < r) andalso (r < 14)) then (ins r) else ()
  176.  
  177.   (* Free a temporary register. *)
  178.     fun freeTmpReg (REG r) = ins r
  179.  
  180.     end (* local *)
  181.  
  182.  
  183.   (* align is a nop, since strings are automatically padded. *)
  184.     fun align () = ()
  185.  
  186.     val emitlong = C.emitLong
  187.     val realconst = C.emitReal
  188.     val emitstring = C.emitString
  189.  
  190.     fun emitlab (n, ImmedLab lab) = C.emitLabel (lab, n)
  191.       | emitlab _ = ErrorMsg.impossible "[SparcCM.emitlab]"
  192.  
  193.     val newlabel = ImmedLab o C.newLabel
  194.     fun define (ImmedLab lab) = C.define lab
  195.       | define _ = ErrorMsg.impossible "[SparcCM.define]"
  196.  
  197.     datatype immed_size = Immed13 | Immed32
  198.  
  199.     fun sizeImmed n = if (~4096 <= n) andalso (n < 4096) then Immed13 else Immed32
  200.  
  201.  
  202.   (** Utility operations **)
  203.  
  204.     fun emitMove (src, dst) = emit_or (zeroR, REGrand src, dst)
  205.  
  206.     fun loadImmed32 (n, r) = let
  207.       val lo10 = Bits.andb(n, 1023)
  208.       in
  209.         emit_sethi (IMrand(Bits.rshift(n, 10)), r);
  210.         if (lo10 <> 0) then emit_or(r, IMrand lo10, r) else ()
  211.       end
  212.  
  213.     fun loadImmed (n, r) = (
  214.       case (sizeImmed n)
  215.        of Immed13 => emit_or(zeroR, IMrand n, r)
  216.         | Immed32 => loadImmed32 (n, r))
  217.  
  218.     fun op32 f (r1, n, r2) = let val tmpR = getTmpReg()
  219.       in
  220.         loadImmed32 (n, tmpR);
  221.         f (r1, REGrand tmpR, r2);
  222.         freeTmpReg tmpR
  223.       end
  224.  
  225.     fun loadReg(r, offset, dst) = (
  226.       case (sizeImmed offset)
  227.        of Immed13 => emit_ld (r, IMrand offset, dst)
  228.         | Immed32 => (op32 emit_ld) (r, offset, dst))
  229.  
  230.     fun store (src, r, offset) = (
  231.       case (sizeImmed offset)
  232.        of Immed13 => emit_st (r, IMrand offset, src)
  233.         | Immed32 => (op32 emit_st) (r, offset, src))
  234.  
  235.     fun addImmed (r, n, dst) = (
  236.       case (sizeImmed n)
  237.        of Immed13 => emit_add (r, IMrand n, dst)
  238.         | Immed32 => (op32 emit_add) (r, n, dst))
  239.  
  240.     fun compareImmed (r, n) = (
  241.       case (sizeImmed n)
  242.        of Immed13 => emit_subcc (r, IMrand n, zeroR)
  243.         | Immed32 => (op32 emit_subcc) (r, n, zeroR))
  244.  
  245.     fun sparcCC EQL = CC_E | sparcCC NEQ = CC_NE
  246.       | sparcCC GTR = CC_G | sparcCC GEQ = CC_GE
  247.       | sparcCC LSS = CC_L | sparcCC LEQ = CC_LE
  248.  
  249.  
  250.   (** CMachine instructions **)
  251.  
  252.   (* move (src, dst) *)
  253.     fun move (Immed n, Direct r) = loadImmed (n, r)
  254.       | move (ImmedLab lab, Direct r) = loadAddr (lab, 0, r)
  255.       | move (FDirect (FREG fs), FDirect (FREG fd)) = let
  256.       fun even x = (Bits.andb(x, 0x1) = 0)
  257.       in
  258.         if (even fs andalso even fd)
  259.           then (
  260.         emit_fmov(FREG fs, FREG fd);
  261.         emit_fmov(FREG (fs+1), FREG (fd+1)))
  262.           else ErrorMsg.impossible "[SparcCM.move: bad floating point registers]"
  263.     end
  264.       | move (Direct r1, Direct r2) = emitMove (r1, r2)
  265.       | move _ = ErrorMsg.impossible "[SparcCM.move]"
  266.  
  267.    fun testLimit () = emit_subcc (dataptrR, limitptrRand, zeroR)
  268.  
  269.    val startgc_offset = 88
  270.  
  271.   (* checkLimit (n):
  272.    * Generate code to check the heap limit to see if there is enough free space
  273.    * to allocate n bytes.
  274.    *)
  275.   fun checkLimit(max_allocation, restart, mask) =
  276.       (* NOTE: THIS CODE USES TEMP REGS BY ALIASES.
  277.        Thus it is important that none of the emitted pseudo-instructions
  278.        below uses getTmpReg(), directly or indirectly. *)
  279.     let val lab' = C.newLabel()
  280.     val n = max_allocation - 4096
  281.      in if n > 0
  282.         then if n<2048
  283.          then (emit_add(dataptrR,IMrand n,checkR);
  284.            emit_subcc(checkR, limitptrRand, zeroR))
  285.          else (emit_sethi(IMrand(Bits.rshift(n,10)),checkR);
  286.            emit_or(checkR, IMrand(Bits.andb(n,1023)), checkR);
  287.            emit_add(dataptrR, REGrand checkR, checkR);
  288.            emit_subcc(checkR, limitptrRand, zeroR))
  289.         else ();
  290.     emit_bcc (CC_LE, lab');
  291.     loadReg(spR, startgc_offset, checkR);
  292.         move(mask, Direct maskR);
  293.     move(restart, Direct linkR);
  294.     emit_jmp (checkR, zeroRand);
  295.         C.define lab'
  296.     end
  297.  
  298.   (* beginStdFn ():
  299.    * Note the beginning of a standard function.  This requires generating 
  300.    * code to load the base code block address into baseCodePtr.
  301.    *)
  302.     fun beginStdFn(ImmedLab lab, Direct reg) = setBaseAddr(lab,reg)
  303.  
  304.   (* jmp (dst):
  305.    * Unconditional jump to destination.
  306.    *)
  307.     fun jmp (ImmedLab lab) = emit_bcc (CC_A, lab)
  308.       | jmp (Direct r) = emit_jmp (r, zeroRand)
  309.       | jmp _ = ErrorMsg.impossible "[SparcCM.jmp]"
  310.  
  311.   (* record (vl, dst):
  312.    * makes a new record, puts address of it into the destination specified
  313.    * by the second arg. The contents are numbered from ~1 and up.
  314.    *)
  315.     fun record (vl : (EA * CPS.accesspath) list, Direct dst) = let
  316.       val len = length vl
  317.       val minBlockSize = 6
  318.     (* generate code to move one or more adjacent fields from one record into
  319.      * adjacent fields in the new record.  If the block is big enough, then
  320.      * use a block copy loop.
  321.      *)
  322.       fun blockMove (srcR, startindx, path, offset) = let
  323.           (* check a CPS path to see how large the block is *)
  324.         fun chkpath (cnt, i,
  325.             path as (Direct r, CPS.SELp(j, CPS.OFFp 0)) :: rest) =
  326.               if (r = srcR) andalso (i+offset = j)
  327.             then chkpath (cnt+1, i-1, rest)
  328.             else (cnt, path)
  329.           | chkpath (cnt, _, rest) = (cnt, rest)
  330.           (* generate code to move fields individually *)
  331.         fun moveFields (0, _) = ()
  332.           | moveFields (n, indx) = let val tmpR = getTmpReg()
  333.               in
  334.             loadReg(srcR, (indx+offset)*4, tmpR);
  335.             store (tmpR, dataptrR, indx*4);
  336.             freeTmpReg tmpR;
  337.             moveFields(n-1, indx-1)
  338.               end
  339.         val (blksz, rest) = chkpath(1, startindx-1, path)
  340.         in
  341.           if (blksz < minBlockSize)
  342.             then moveFields(blksz, startindx)
  343.             else if (offset = 0)
  344.               then let
  345.             val lab = C.newLabel()
  346.             val indxR = getTmpReg() and tmpR = getTmpReg()
  347.             in
  348.               loadImmed (startindx*4, indxR);
  349.               C.define lab;
  350.               emit_ld (srcR, REGrand indxR, tmpR);
  351.               compareImmed (indxR, (startindx-blksz)*4);
  352.               emit_st (dataptrR, REGrand indxR, tmpR);
  353.               emit_sub (indxR, IMrand 4, indxR);
  354.               emit_bcc (CC_G, lab);
  355.               freeTmpReg indxR; freeTmpReg tmpR
  356.             end
  357.               else let
  358.             val lab = C.newLabel()
  359.             val indxR1 = getTmpReg() and indxR2 = getTmpReg()
  360.             val tmpR = getTmpReg()
  361.             in
  362.               loadImmed ((startindx+offset)*4, indxR1);
  363.               loadImmed (startindx*4, indxR2);
  364.               C.define lab;
  365.               emit_ld (srcR, REGrand indxR1, tmpR);
  366.               emit_sub (indxR1, IMrand 4, indxR1);
  367.               emit_st (dataptrR, REGrand indxR2, tmpR);
  368.               emit_sub (indxR2, IMrand 4, indxR2);
  369.               compareImmed (indxR1, (startindx+offset-blksz)*4);
  370.               emit_bcc (CC_G, lab);
  371.               freeTmpReg indxR1; freeTmpReg indxR2; freeTmpReg tmpR
  372.             end;
  373.           freeReg srcR;
  374.           (startindx-blksz, rest)
  375.         end (* blockMove *)
  376.       (* For each field in the record generate the necessary moves to initialize
  377.        * it in the new record.
  378.        *)
  379.       fun fields (_, nil) = ()
  380.         | fields (i, (Direct r, CPS.SELp(j, CPS.OFFp 0)) :: rest) =
  381.         fields (blockMove (r, i, rest, j-i))
  382.         | fields (i, (Direct r, CPS.SELp(j, p)) :: rest) = let
  383.         val tmpR = getTmpReg()
  384.         in
  385.           loadReg(r, j*4, tmpR);
  386.           freeReg r;
  387.           fields (i, (Direct tmpR, p) :: rest)
  388.         end
  389.         | fields (i, (Direct r, CPS.OFFp 0) :: rest) = (
  390.         store (r, dataptrR, i*4);
  391.         freeReg r;
  392.         fields (i-1, rest))
  393.         | fields (i, (Direct r, CPS.OFFp j) :: rest) = let
  394.         val tmpR = getTmpReg()
  395.         val offset = j*4
  396.         in
  397.           case sizeImmed offset
  398.            of Immed13 => emit_add (r, IMrand offset, tmpR)
  399.             | Immed32 => (
  400.             loadImmed32 (offset, tmpR);
  401.             emit_add (r, REGrand tmpR, tmpR))
  402.           (* end case *);
  403.           store (tmpR, dataptrR, i*4);
  404.           freeTmpReg tmpR; freeReg r;
  405.           fields (i-1, rest)
  406.         end
  407.         | fields (i, (x, p) :: rest) =  let
  408.         val tmpR = getTmpReg()
  409.         in
  410.           move (x, Direct tmpR);
  411.           fields (i, (Direct tmpR, p) :: rest)
  412.         end
  413.       in
  414.         fields (len-2, rev vl);
  415.         emitMove (dataptrR, dst);
  416.         addImmed (dataptrR, len*4, dataptrR)
  417.     end
  418.       | record _ = ErrorMsg.impossible "[SparcCM.record]"
  419.  
  420.   (* recordStore(x, y, alwaysBoxed) records a store operation into mem[x+2*(z-1)].
  421.    * The flag alwaysBoxed is true if the value stored is guaranteed to be boxed.
  422.    *)
  423.     fun recordStore (x, y, _) = record ([
  424.         (Immed(System.Tags.make_desc(3, System.Tags.tag_record)), CPS.OFFp 0),
  425.         (x, CPS.OFFp 0), (y, CPS.OFFp 0), (storeptr, CPS.OFFp 0)
  426.       ], storeptr)
  427.  
  428.   (* select (i, x, y):  y <- mem[x + 4*i] *)
  429.     fun select (i, Direct r, Direct dst) = loadReg(r, i*4, dst)
  430.       | select (i, ImmedLab lab, Direct dst) = let val tmpR = getTmpReg()
  431.       in
  432.         load (lab, i*4, dst, tmpR);
  433.         freeTmpReg tmpR
  434.       end
  435.       | select _ = ErrorMsg.impossible "[SparcCM.select]"
  436.  
  437.   (* offset (i, x, y):  y <- (x + 4*i) *)
  438.     fun offset (i, Direct r, Direct dst) = addImmed (r, 4*i, dst)
  439.       | offset (i, ImmedLab lab, Direct dst) = loadAddr (lab, i, dst)
  440.       | offset _ = ErrorMsg.impossible "[SparcCM.offset]"
  441.  
  442.     local
  443.       fun moveByte movFn = let
  444.         fun mov (Direct r, Direct base, Direct indx) = movFn(base, REGrand indx, r)
  445.           | mov (Direct r, Direct base, Immed indx) = (
  446.           case (sizeImmed indx)
  447.            of Immed13 => movFn (base, IMrand indx, r)
  448.             | Immed32 => (op32 movFn) (base, indx, r))
  449.           | mov _ = ErrorMsg.impossible "[SparcCM.moveByte]"
  450.         in
  451.           mov
  452.         end
  453.       val loadByte = moveByte emit_ldb
  454.       val storeByte = moveByte emit_stb
  455.     in
  456.  
  457.   (* fetchindexb (x, y, z) fetches an unsigned byte:  y <- mem[x+z] *)
  458.     fun fetchindexb (base, dst, indx) = loadByte(dst, base, indx)
  459.  
  460.   (* storeindexb (x, y, z) stores a byte:  mem[y+z] <- x *)
  461.     fun storeindexb (Immed i, base, indx) = let
  462.       val tmpR = getTmpReg()
  463.       in
  464.         loadImmed (i, tmpR);
  465.         storeByte (Direct tmpR, base, indx);
  466.         freeTmpReg tmpR
  467.       end
  468.       | storeindexb arg = storeByte arg
  469.     end (* local *)
  470.  
  471.   (* jmpindexb (x):  pc <- (x+y) *)
  472.     fun jmpindexb(ImmedLab lab, Direct y) = let
  473.       val tmpR1 = getTmpReg()
  474.       in
  475.         loadAddr (lab, 0, tmpR1);
  476.         emit_jmp (tmpR1, REGrand y);
  477.         freeTmpReg tmpR1
  478.       end
  479.       | jmpindexb _ = ErrorMsg.impossible "[SparcCM.jmpindexb]"
  480.  
  481.   (* fetchindexl (x, y, z) fetches a word:  y <- mem[x+2*(z-1)] *)
  482.     fun fetchindexl (Direct r1, Direct dst, Direct r2) = let
  483.       val tmpR = getTmpReg()
  484.       in
  485.         emit_sub (r2, IMrand 1, tmpR);
  486.         emit_add (tmpR, REGrand tmpR, tmpR);
  487.         emit_ld (r1, REGrand tmpR, dst);
  488.         freeTmpReg tmpR
  489.       end
  490.       | fetchindexl (Direct r1, Direct dst, Immed i) = loadReg(r1, 2*(i-1), dst)
  491.       | fetchindexl (ImmedLab lab, Direct dst, Direct r) =  let
  492.       val tmpR1 = getTmpReg()
  493.       in
  494.         loadAddr (lab, ~2, tmpR1);
  495.         emit_add (r, REGrand tmpR1, tmpR1);
  496.         emit_ld (r, REGrand tmpR1, dst);
  497.         freeTmpReg tmpR1
  498.       end
  499.       | fetchindexl _ = ErrorMsg.impossible "[SparcCM.fetchindexl]"
  500.  
  501.   (*storeindexl (x, y, z) stores a word:  mem[y+2*(z-1)] <- x *)
  502.     fun storeindexl (Direct src, Direct r1, Direct r2) = let val tmpR = getTmpReg()
  503.       in
  504.         emit_sub (r2, IMrand 1, tmpR);
  505.         emit_add (tmpR, REGrand tmpR, tmpR);
  506.         emit_st (r1, REGrand tmpR, src);
  507.         freeTmpReg tmpR
  508.       end
  509.       | storeindexl (Direct src, Direct r, Immed i) = store (src, r, 2*(i-1))
  510.       | storeindexl (Immed n, x, y) = let val tmpR = getTmpReg()
  511.       in
  512.         loadImmed (n, tmpR);
  513.         storeindexl (Direct tmpR, x, y);
  514.         freeTmpReg tmpR
  515.       end
  516.       | storeindexl (ImmedLab lab, x, y) = let
  517.       val tmpR1 = getTmpReg()
  518.       in
  519.         loadAddr (lab, 0, tmpR1);
  520.         storeindexl (Direct tmpR1, x, y);
  521.         freeTmpReg tmpR1
  522.       end
  523. (** NOTE: in a sane world the following case would be unecessary, but it
  524.  ** is used in an ugly profiling hack.
  525.  **)
  526.       | storeindexl (Direct src, ImmedLab lab, Immed i) = let
  527.       val tmpR1 = getTmpReg()
  528.       in
  529.         loadAddr (lab, 2*(i-1), tmpR1);
  530.         emit_st (tmpR1, zeroRand, src);
  531.         freeTmpReg tmpR1
  532.       end
  533.       | storeindexl _ = ErrorMsg.impossible "[SparcCM.storeindexl]"
  534.  
  535.  
  536.    (* fetchindexd(x,y,z): y <- mem[x+4*(z-1)] *)
  537.     fun fetchindexd(Direct x, FDirect(FREG fp), Direct z) = let
  538.       val tmpR = getTmpReg()
  539.       in
  540.         emit_sll (z, IMrand 2, tmpR);
  541.         emit_add (tmpR, REGrand x, tmpR);
  542.         emit_ldf (tmpR, IMrand ~4, FREG fp);
  543.         emit_ldf (tmpR, zeroRand, FREG(fp+1));
  544.         freeTmpReg tmpR
  545.       end
  546.       | fetchindexd(Direct x, FDirect(FREG fp), Immed i) = let
  547.       val offset = 4*(i-1)
  548.       in
  549.         case sizeImmed (offset+4) 
  550.          of Immed13 => (
  551.           emit_ldf(x, IMrand offset, FREG fp);
  552.           emit_ldf(x, IMrand(offset+4), FREG(fp+1)))
  553.           | Immed32 => let val tmpR = getTmpReg()
  554.           in
  555.             loadImmed(offset,tmpR);
  556.             emit_add(x,REGrand tmpR,tmpR);
  557.             emit_ldf(tmpR,zeroRand,FREG fp);
  558.             emit_ldf(tmpR,IMrand 4,FREG(fp+1));
  559.             freeTmpReg tmpR
  560.           end
  561.           end
  562.       | fetchindexd _ = ErrorMsg.impossible "[SparcCM.fetchindexd]"
  563.  
  564.   (* storeindexd: mem[y+4*(z-1)] <- x *)
  565.     fun storeindexd (FDirect(FREG fp), Direct y, Direct z) = let
  566.       val tmpR = getTmpReg()
  567.       in
  568.         emit_sll (z, IMrand 2, tmpR);
  569.         emit_add (tmpR, REGrand y, tmpR);
  570.         emit_stf (tmpR, IMrand ~4, FREG fp);
  571.         emit_stf (tmpR ,zeroRand, FREG (fp+1));
  572.         freeTmpReg tmpR
  573.       end
  574.       | storeindexd (FDirect(FREG fp), Direct y, Immed i) = let
  575.       val offset = 4*(i-1)
  576.       in
  577.         case (sizeImmed (offset+4))
  578.          of Immed13 => (
  579.           emit_stf (y, IMrand offset, FREG fp);
  580.           emit_stf (y, IMrand (offset+4), FREG(fp+1)))
  581.           | Immed32 => let
  582.           val tmpR = getTmpReg()
  583.           in
  584.             loadImmed(offset,tmpR);
  585.             emit_add(y,REGrand tmpR,tmpR);
  586.             emit_stf(tmpR,zeroRand,FREG fp);
  587.             emit_stf(tmpR,IMrand 4,FREG(fp+1));
  588.             freeTmpReg tmpR
  589.           end
  590.       end
  591.       | storeindexd _ = ErrorMsg.impossible "[SparcCM.storeindexd]"
  592.  
  593.   (* ashl (n, x, y) shift left: y <- (x << n), with  n >= 0 *)
  594.     fun ashl (Direct cntR, Direct src, Direct dst) =
  595.       emit_sll(src, REGrand cntR, dst)
  596.       | ashl (Immed cnt, Direct src, Direct dst) =
  597.       emit_sll (src, IMrand(Bits.andb(cnt, 31)), dst)
  598.       | ashl (Direct cntR, Immed src, Direct dst) = let val tmpR = getTmpReg()
  599.       in
  600.         loadImmed (src, tmpR);
  601.         emit_sll (tmpR, REGrand cntR, dst);
  602.         freeTmpReg tmpR
  603.       end
  604.       | ashl (Immed cnt, Immed src, Direct dst) = (
  605.       loadImmed (Bits.lshift(src, cnt), dst))
  606.       | ashl _ = ErrorMsg.impossible "[SparcCM.ashl]"
  607.  
  608.   (* ashr (n, x, y) shift right: y <- (x >> n), with  n >= 0 *)
  609.     fun ashr (Direct cntR, Direct src, Direct dst) =
  610.       emit_sra (src, REGrand cntR, dst)
  611.       | ashr (Immed cnt, Direct src, Direct dst) =
  612.       emit_sra (src, IMrand(Bits.andb(cnt, 31)), dst)
  613.       | ashr (Direct cntR, Immed src, Direct dst) = let val tmpR = getTmpReg()
  614.       in
  615.         loadImmed (src, tmpR);
  616.         emit_sra (tmpR, REGrand cntR, dst);
  617.         freeTmpReg tmpR
  618.       end
  619.       | ashr (Immed cnt, Immed src, Direct dst) = (
  620.       loadImmed (Bits.rshift(src, cnt), dst))
  621.       | ashr _ = ErrorMsg.impossible "[SparcCM.ashr]"
  622.  
  623.     local
  624.     fun adjArgs f (a as Immed _, b, c) = f (b, a, c)
  625.       | adjArgs f args = f args
  626.     fun adjSubArgs f (a, Immed 0, c) = f(Direct(zeroR), a, c)
  627.       | adjSubArgs f (a, Immed b, c) = let val tmpR = getTmpReg()
  628.           in
  629.         loadImmed (b, tmpR);
  630.         f (Direct tmpR, a, c);
  631.         freeTmpReg tmpR
  632.           end
  633.       | adjSubArgs f (a, b, c) = f (b, a, c)
  634.     fun arithOp f (Direct r1, Direct r2, Direct dst) = f (r1, REGrand r2, dst)
  635.       | arithOp f (Direct r, Immed n, Direct dst) = (
  636.           case (sizeImmed n)
  637.            of Immed13 => f (r, IMrand n, dst)
  638.         | Immed32 => let val tmpR = getTmpReg()
  639.             in
  640.               loadImmed32 (n, tmpR);
  641.               f (r, REGrand tmpR, dst);
  642.               freeTmpReg tmpR
  643.             end)
  644.       | arithOp _ _ = ErrorMsg.impossible "[SparcCM.arithOp]"
  645.     val addt' = adjArgs (arithOp (fn args => (emit_addcc args; emit_tvs())))
  646.     in
  647.  
  648.     val orb = adjArgs (arithOp emit_or)
  649.     val andb = adjArgs (arithOp emit_and)
  650.     val xorb = adjArgs (arithOp emit_xor)
  651.     fun notb (Direct src, Direct dst) = emit_not (src, dst)
  652.       | notb _ = ErrorMsg.impossible "[SparcCM.notb]"
  653.  
  654.     val add = adjArgs (arithOp emit_add)
  655.     fun addt (Immed a, b as Immed _, dst) = let val tmpR = getTmpReg ()
  656.     (* This should only occur when we need to build a constant larger than
  657.      * 2^29.  Note, we assume that "b" is tagged (see "cps/generic.sml").
  658.      *)
  659.       in
  660.         loadImmed (a, tmpR);
  661.         addt' (Direct tmpR, b, dst);
  662.         freeTmpReg tmpR
  663.       end
  664.       | addt args = addt' args
  665.  
  666.     val op sub = adjSubArgs (arithOp emit_sub)
  667.     val subt = adjSubArgs (arithOp (fn args => (emit_subcc args; emit_tvs())))
  668.  
  669.     end (* local *)
  670.  
  671.   (* mult/divt:
  672.    * mult (a, b):  b <- (a * b) (with overflow checking done by ml_mul)
  673.    * divt (a, b):  b <- (b div a)
  674.    *)
  675.     local
  676.       (* call an off-line arithmetic routine. *)
  677.     fun intOp opAddrOffset (a, b as Direct _) = (
  678.           emit_ld (spR, opAddrOffset, opAddrR);
  679.           move (a, arg2EA);
  680.           move (b, arg1EA);
  681.           emit_jmpl (opAddrR, zeroRand, linkR);
  682.           move (arg1EA, b))
  683.       | intOp _ _ = ErrorMsg.impossible "[SparcCM.intOp]"
  684.     val mulAddrOffset = IMrand 72
  685.     val divAddrOffset = IMrand 76
  686.     in
  687.     val mult = intOp mulAddrOffset
  688.     val divt = intOp divAddrOffset
  689.     end (* local *)
  690.  
  691.   (* bbs (i, dst, lab): test the i'th bit of dst and jump to lab if it is zero *)
  692.     fun bbs (Immed i, Direct r, ImmedLab lab) = (
  693.       emit_andcc (r, IMrand(Bits.lshift(1, i)), zeroR);
  694.       emit_bcc (CC_NE, lab))
  695.       | bbs _ = ErrorMsg.impossible "[SparcCM.bbs]"
  696.  
  697.     local
  698.       fun revCC CC_A = CC_A
  699.     | revCC CC_E = CC_E     | revCC CC_NE = CC_NE
  700.     | revCC CC_L = CC_G     | revCC CC_LE = CC_GE
  701.     | revCC CC_G = CC_L     | revCC CC_GE = CC_LE
  702.     | revCC CC_LEU = CC_GEU | revCC CC_GEU = CC_LEU
  703.       fun compare (cc, a as Immed _, b as Direct _) = compare (revCC cc, b, a)
  704.     | compare (cc, Direct r1, Direct r2) = (emit_subcc (r1, REGrand r2, zeroR); cc)
  705.     | compare (cc, Direct r1, Immed n) = (compareImmed (r1, n); cc)
  706.     | compare _ = ErrorMsg.impossible "[SparcCM.compare]"
  707.     in
  708.  
  709.   (* ibranch (cond, a, b, lab): if (a <cond> b) then pc <- lab *)
  710.     fun ibranch (cond, a, b, ImmedLab lab) = emit_bcc (compare (sparcCC cond, a, b), lab)
  711.  
  712.   (* rangeChk (a, b, lab):  pc <- lab if ((a < 0) or (b <= a)) *)
  713.     fun rangeChk (a, b, ImmedLab lab) = emit_bcc (compare(CC_GEU, a, b), lab)
  714.  
  715.     end (* local *)
  716.  
  717.  
  718.     (*
  719.      * Floating point arithmetic instructions
  720.      *)
  721.     local
  722.     (* Fetch a ML real value into a floating-point register pair *)
  723.       fun fetchReal (Direct r, FREG i) = (
  724.         emit_ldf (r, zeroRand, FREG i);
  725.         emit_ldf (r, IMrand 4, FREG(i+1)))
  726.     | fetchReal (ImmedLab lab, dst) = let val tmpR = getTmpReg()
  727.         in
  728.           loadF (lab, 0, dst, tmpR);
  729.           freeTmpReg tmpR
  730.         end
  731.     | fetchReal _ = ErrorMsg.impossible "[SparcCM.fetchReal]"
  732.       fun floatOp fOp (FDirect fpr1, FDirect fpr2, FDirect fpr3) = fOp(fpr1,fpr2,fpr3)
  733.     | floatOp _ _ = ErrorMsg.impossible "[SparcCM.floatOp]"
  734.     in
  735.  
  736.     fun loadfloat (src, FDirect fpr) = fetchReal(src, fpr)
  737.       | loadfloat _ = ErrorMsg.impossible "[SparcCM.loadfloat]"
  738.  
  739.     fun storefloat (FDirect(FREG fpr), Direct(REG gpr)) = let val tmpR = getTmpReg()
  740.       in
  741.         loadImmed (System.Tags.desc_reald, tmpR);
  742.         emit_st (dataptrR, IMrand(~4), tmpR);
  743.         emit_stf (dataptrR, zeroRand, FREG fpr);
  744.         emit_stf (dataptrR, IMrand 4, FREG (fpr+1));
  745.         emitMove (dataptrR, REG gpr);
  746.         emit_add (dataptrR, IMrand 12, dataptrR);
  747.         freeTmpReg tmpR
  748.       end
  749.       | storefloat _ = ErrorMsg.impossible "[SparcCM.storefloat]"
  750.  
  751.     val faddd = floatOp emit_fadd
  752.     val fsubd = floatOp emit_fsub
  753.     val fmuld = floatOp emit_fmul
  754.     val fdivd = floatOp emit_fdiv
  755.  
  756.     fun fnegd (FDirect (fpr1 as FREG f1), FDirect (fpr2 as FREG f2)) = (
  757.       emit_fneg (fpr1, fpr2);
  758.       if (fpr1 <> fpr2) then emit_fmov (FREG(f1+1), FREG(f2+1)) else ())
  759.       | fnegd _ = ErrorMsg.impossible "[SparcCM.fnegd]"
  760.  
  761.     fun fabsd (FDirect (fpr1 as FREG f1), FDirect (fpr2 as FREG f2)) = (
  762.       emit_fabs (fpr1, fpr2);
  763.       if (fpr1 <> fpr2) then emit_fmov (FREG(f1+1), FREG(f2+1)) else ())
  764.       | fabsd _ = ErrorMsg.impossible "[SparcCM.fabsd]"
  765.  
  766.   (* convert an int to a double.  Because there is no data-path from general
  767.    * purpose registers to the FP registers, we use the heap as a staging point.
  768.    *)
  769.     local
  770.       val cvti2dAddrOffset = IMrand 92
  771.       fun convert (gpr, fpr) = (
  772.         emit_st (spR, cvti2dAddrOffset, gpr);
  773.             emit_ldf (spR, cvti2dAddrOffset, fpr);
  774.         emit_fitod (fpr, fpr))
  775.     in
  776.     fun cvti2d (Direct r, FDirect fpr) = convert (r, fpr)
  777.       | cvti2d (Immed i, FDirect fpr) = let val tmpR = getTmpReg()
  778.       in
  779.         loadImmed (i, tmpR);
  780.         convert (tmpR, fpr);
  781.         freeTmpReg tmpR
  782.       end
  783.       | cvti2d _ = ErrorMsg.impossible "[SparcCM.cvti2d]"
  784.     end (* local fun convert ... *)
  785.  
  786.     fun fbranchd (cond, FDirect fp1, FDirect fp2, ImmedLab lab) = (
  787.       emit_fcmp(fp1,fp2);
  788.       emit_fbcc(sparcCC cond, lab))
  789.       | fbranchd _ = ErrorMsg.impossible "[SparcCM.fbranchd]"
  790.     end (* local *)
  791.  
  792.     end (* local *)
  793.  
  794.   end (* functor SparcCM *)
  795.